home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / namevars.arc / NAMEVARS.PRG
Encoding:
Text File  |  1986-11-25  |  7.2 KB  |  194 lines
  1. * Program..: NAMEVARS.PRG
  2. * Author...: Steve Titterud, a modified version of another author's work.
  3. * Notes....: This utility saves a little, but only a little, of the drudge
  4. *            work in writing dBase programs.  It will generate blocks of code
  5. *            to be used within programs and write them to a filename the
  6. *            user specifies, for later block copying into the appropriate
  7. *            part of your program.
  8. *            Generates memvar names from field names, writes initialization
  9. *            text for memvars to blanks, for memvars to fields, and replace
  10. *            statements, all for later copying into actual program segment.
  11. *            Must pass datafile name (default extension is .dbf) and text
  12. *            output filename (no extension defaults to .txt) to this program.
  13. *            If no directory given, current directory is default.
  14. *            Also can create a datafile, "m_%datafile", with all fieldnames
  15. *            equal to datafile fieldnames, prefixed by "m_". (for UI.exe).
  16. set echo off
  17. SET TALK OFF
  18. set safety off
  19. notquit=.T.
  20. do while notquit
  21.    clear
  22.    * establish datafile name and m_datafile name; if datafile not found, quit...
  23.    dirdata=space(15)
  24.    dirtext=space(15)
  25.    datafile=space(12)
  26.    textfile=space(12)
  27.    @ 0,0 say "We are about to write code fragments based on fields of datafile to a textfile."
  28.    @ 2,5 say "Specify directory and filename for both datafile and textfile..."
  29.    @ 3,5 say "(defaults if no value specified: current directory, .dbf, and .txt)"
  30.    @ 7,5 say "Directory of datafile? " get dirdata
  31.    @ 7,45 say "Datafile? " get datafile
  32.    @ 9,5 say "Directory of textfile? " get dirtext
  33.    @ 9,45 say "Textfile? " get textfile
  34.    @ 22,20 say "<Esc> to quit."
  35.    read
  36.    r=readkey()
  37.    if r=12 .or. r=268
  38.       set talk on
  39.       set echo on
  40.       set safety on
  41.       return
  42.    endif
  43.    ** The four if-endif blocks of active code accessed through 4 switches:
  44.    mem2blanks=.F.
  45.    mem2flds=.F.
  46.    replflds=.F.
  47.    doUI=.F.
  48.    @ 14,5 say " Of the four outputs:  1. Initialize memvars to blanks."
  49.    @ 15,5 say "                       2. Initialize memvars to field values."
  50.    @ 16,5 say "                       3. Generate replacement statements."
  51.    @ 17,5 say "                       4. Create m_"+datafile+" for use with UI."
  52.    choices="    "
  53.    do while len(trim(choices))=0 .or. .not. ("1"$choices .or. "2"$choices .or. "3"$choices .or. "4"$choices)
  54.       choices="    "
  55.       @ 19,5 say "Which do you want ?" get choices
  56.       @ 19,30 say "(no delimiters needed: e.g., 134 or 24, etc.)"
  57.       read
  58.    enddo
  59.    r=readkey()
  60.    if r=12 .or. r=268
  61.       set talk on
  62.       set echo on
  63.       set safety on
  64.       return
  65.    endif
  66.    ** set switches to values based upon content of choices
  67.    mem2blanks=iif("1"$choices,.T.,.F.)
  68.    mem2flds=iif("2"$choices,.T.,.F.)
  69.    replflds=iif("3"$choices,.T.,.F.)
  70.    doUI=iif("4"$choices,.T.,.F.)
  71.    if (mem2blanks .or. mem2flds .or. replflds .or. doUI)  && at least 1 output selected
  72.       ** establish all filenames
  73.       dirdata=ltrim(rtrim(dirdata))
  74.       dirtext=ltrim(rtrim(dirtext))
  75.       datafile=ltrim(rtrim(datafile))
  76.       textfile=ltrim(rtrim(textfile))
  77.       dirdata=iif(len(dirdata)=0,"",iif(right(dirdata,1)="\",dirdata,dirdata+"\"))
  78.       dirtext=iif(len(dirtext)=0,"",iif(right(dirtext,1)="\",dirtext,dirtext+"\"))
  79.       datafile=iif("."$datafile,datafile,datafile+".dbf")
  80.       textfile=iif("."$textfile,textfile,textfile+".txt")
  81.       m_datafile="m_"+substr(datafile,1,at(".",datafile)-1)
  82.       m_datafile=substr(m_datafile,1,8)
  83.       m_datafile=m_datafile+substr(datafile,at(".",datafile),4)
  84.       datafile=dirdata+datafile
  85.       textfile=dirtext+textfile
  86.       m_datafile=dirtext+m_datafile
  87.       IF FILE(datafile)
  88.          USE &datafile
  89.          clear
  90.          @ 10,20 say "Creating files..."
  91.          set console off
  92.       ELSE  && it's not here - go back and do again
  93.          clear
  94.          @ 10,10 say datafile + " not found. Re-check file name or location of file."
  95.          @ 23,0
  96.          wait
  97.          loop
  98.       ENDIF
  99.       * Copy twice to stru exte files to set up field names in primary and secondary...
  100.       copy to noprefix stru exte
  101.       COPY TO prefix STRUCTURE EXTENDED
  102.       select 2
  103.       use noprefix
  104.       select 1
  105.       USE prefix
  106.       ** match up fields with relation on record number
  107.       set relation to recno() into noprefix
  108.       ** Change field names (which become memvars) to lower case...
  109.       ** prefix will hold fields with "m_" prefix
  110.       REPLACE ALL Field_name WITH "m_"+LOWER(Field_name)
  111.       CLEAR
  112.       * Establish alternate file for text output...
  113.       SET ALTERNATE TO &textfile
  114.       SET ALTERNATE ON
  115.       set console on
  116.       clear
  117.       if mem2blanks
  118.       @ 10,10 say "Writing initializations as blanks to "+textfile+"...."
  119.       set console off
  120.       * Initialize memvars to blank values
  121.       STORE "00000000000000000000" TO zeros
  122.       go top
  123.       DO WHILE .NOT. EOF()
  124.          DO CASE
  125.             CASE Field_type = "C"
  126.                ? Field_name+" = SPACE("+STR(Field_len,3)+")"
  127.             CASE Field_type = "N" .AND. Field_dec = 0
  128.                ? Field_name +" = " + SUBSTR(zeros,1,Field_len-Field_dec)
  129.             CASE Field_type = "N" .AND. Field_dec > 0
  130.                ? Field_name +" = "+SUBSTR(zeros,1,Field_len-Field_dec-1)+"."+SUBSTR(zeros,1,Field_dec)
  131.             CASE Field_type = "L"
  132.                ? Field_name+" = .F."
  133.             CASE Field_type = "D"
  134.                ? Field_name+[ = CTOD("  /  /  ")]
  135.          ENDCASE
  136.          SKIP
  137.       ENDDO
  138.       endif
  139.       if mem2flds
  140.       * Initialize memvars to field values...
  141.       set console on
  142.       clear
  143.       @ 10,10 say "Writing initializations as field values to "+textfile+"...."
  144.       set console off
  145.       GO TOP
  146.       ?
  147.       DO WHILE .NOT. EOF()
  148.          ? Field_name+" = "+noprefix->Field_name
  149.          SKIP
  150.       ENDDO
  151.       endif
  152.       if replflds
  153.       * Write REPLACE statements...
  154.       set console on
  155.       clear
  156.       @ 10,10 say "Writing REPLACE statements to "+textfile+"...."
  157.       set console off
  158.       GO TOP
  159.       ?
  160.       DO WHILE .NOT. EOF()
  161.          ? "REPLACE " + noprefix->Field_name + " WITH "+Field_name
  162.          SKIP
  163.       ENDDO
  164.          ?   && one last carriage return
  165.       endif
  166.       if doUI
  167.       ** generate datafile to use with Wallsoft's UI.exe since they made
  168.       ** no provision in early version to hand over memvars named from fields;
  169.       ** might as well delete this whole part if they fix it in later version..
  170.       set console on
  171.       clear
  172.       @ 10,10 say "Creating "+m_datafile+" from "+datafile+"...."
  173.       create &m_datafile from prefix
  174.       endif
  175.       erase prefix.dbf  && no more need for these...
  176.       erase noprefix.dbf
  177.       clear
  178.       @ 10,5 say textfile+" now holds initialization and REPLACE statements."
  179.       @ 12,5 say iif(doUI,m_datafile+" holds the renamed fields for UI...","")
  180.       @ 23,30 say "Do another? (Y/N)" get notquit
  181.  
  182.       read
  183.    enddo
  184. endif  && if at least one output selected
  185. * Close up...
  186. set ALTERNATE TO
  187. CLOSE DATABASES
  188. set console on
  189. SET TALK ON
  190. set echo on
  191. set safety on
  192. clear
  193. RETURN
  194.